home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / SupLib.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  315 lines
  1. (*************************************************************************
  2.  
  3. :Program.       SupLib.mod
  4. :Contents.      collection of some routines
  5. :Author.        Hartmut Goebel [hG]
  6. :Copyright.     Public Domain
  7. :Language.      Oberon
  8. :Translator.    AmigaOberon V2.00
  9. :History.       V1.0, 21.01.90, Hartmut Goebel
  10. :History.       V1.1, 18 Oct 1991 [hG] -Bug in StripIntuiMsg
  11. :Date.          18 Oct 1991 22:49:50
  12.  
  13. :Support.       einige Routinen von M.Dillon (Oberon-Impl. von hG)
  14. :Support.       einige andere aus ARKM Libs&Devs 1.3
  15.  
  16. *************************************************************************)
  17.  
  18. MODULE SupLib;
  19.  
  20. IMPORT
  21.   d:   Dos,
  22.   df:  DiskFont,
  23.   e:   Exec,
  24.   g:   Graphics,
  25.   con: Console,
  26.   I:   Intuition,
  27.   ie:  InputEvent,
  28.   km:  KeyMap,
  29.   ol:  OberonLib,
  30.   str: Strings,
  31.   sys: SYSTEM;
  32.  
  33. TYPE
  34.   StringPtr = POINTER TO ARRAY 256 OF CHAR;
  35.  
  36. (*-------------------------------------------------------------------------*)
  37. (*
  38.  *  Win = GetConWindow()
  39.  *
  40.  *  Returns console window associated with the current task or NULL if
  41.  *  no console task associated.
  42.  *
  43.  *  Return the window used by the console of the current process.  We can
  44.  *  use our process's message port as the reply port since it is a
  45.  *  synchronous packet (we wait for the result to come back).  WARNING:
  46.  *  This routine does not check if the 'console' of the current process
  47.  *  is really a console device.
  48.  *
  49.  *  The DISK_INFO packet is sent to the console device.  Although this
  50.  *  packet is normally used to retrieve disk information from disk
  51.  *  devices, the console device recognizes the packet and places a pointer
  52.  *  to the window in id_VolumeNode of the infodata structure.  A pointer
  53.  *  to the console unit is also placed in id_InUse of the infodata structure.
  54.  *)
  55.  
  56. PROCEDURE GetConWindow(): I.WindowPtr;
  57. CONST
  58.   ClearPublic = LONGSET{e.memClear,e.public};
  59. VAR
  60.   proc: d.ProcessPtr;
  61.   packet: d.StandardPacketPtr;
  62.   infodata: d.InfoDataPtr;
  63.   result: LONGINT;
  64.   win: I.WindowPtr;
  65. BEGIN
  66.   proc := sys.VAL(d.ProcessPtr,e.FindTask(NIL));
  67.   IF proc.consoleTask = NIL THEN
  68.       RETURN NIL; END;
  69.   (*
  70.    *  NOTE: Since DOS requires the packet and infodata structures to
  71.    *  be longword aligned, we cannot declare them globally or on the
  72.    *  stack (word aligned).  AllocMem() always returns longword
  73.    *  aligned pointers.
  74.    *)
  75.  
  76.   packet := e.AllocMem(sys.SIZE(d.StandardPacket),ClearPublic);
  77.   infodata := e.AllocMem(sys.SIZE(d.InfoData),ClearPublic);
  78.  
  79.   packet.msg.node.name := sys.ADR(packet.pkt);
  80.   packet.pkt.link := sys.ADR(packet.msg);
  81.   packet.pkt.port := sys.ADR(proc.msgPort);
  82.   packet.pkt.type := d.diskInfo;
  83.   packet.pkt.arg1 := sys.LSH(sys.VAL(LONGINT,infodata),-2); (* BPointer *)
  84.   e.PutMsg(proc.consoleTask, packet);
  85.   e.WaitPort(sys.ADR(proc.msgPort));
  86.   IF e.GetMsg(sys.ADR(proc.msgPort)) = NIL THEN END;
  87.  
  88.   result := packet.pkt.res1;
  89.   win := sys.VAL(I.WindowPtr,infodata.volumeNode);
  90.   (* note: inUse holds a pointer to the console unit also *)
  91.   e.FreeMem(packet  , sys.SIZE(d.StandardPacket));
  92.   e.FreeMem(infodata, sys.SIZE(d.InfoData));
  93.   IF result = NIL THEN
  94.       RETURN NIL; END;
  95.   RETURN win;
  96. END GetConWindow;
  97.  
  98. (*-------------------------------------------------------------------------*)
  99.  
  100. PROCEDURE DeadKeyConvert*(msg: I.IntuiMessagePtr;VAR buf: ARRAY OF CHAR;
  101.                           bufsize: LONGINT; keymap: km.KeyMapPtr): LONGINT;
  102. VAR
  103.   iEvent: ie.InputEventAdr;
  104. BEGIN
  105.   IF NOT (I.rawKey IN msg.class) THEN RETURN -2; END;
  106.   IF con.base = NIL THEN HALT(20); END;
  107.   iEvent.nextEvent := NIL;
  108.   iEvent.class := ie.rawkey;
  109.   iEvent.code := msg.code;
  110.   iEvent.qualifier := msg.qualifier;
  111.   iEvent.addr := msg.iAddress;
  112.   RETURN con.RawKeyConvert(sys.ADR(iEvent),buf,bufsize,keymap);
  113. END DeadKeyConvert;
  114.  
  115. (*-------------------------------------------------------------------------*)
  116.  
  117. (*
  118. *
  119. *  GetDEnv(name: StringPtr): StringPtr;
  120. *  SetDEnv(name, string: StringPtr): BOOLEAN;
  121. *
  122. *    If the enviroment variable 'name' exists, NEW and return a copy
  123. *    of it. The user program must DISPOSE it (or allow the standard
  124. *    OBERON exit routine to DISPOSE it).
  125. *)
  126.  
  127. PROCEDURE GetDEnv*(name: ARRAY OF CHAR): e.ADDRESS;
  128. (* $CopyArrays- *)
  129. VAR
  130.   nlen: INTEGER;
  131.   ptr, res: StringPtr;
  132.   fh: d.FileHandlePtr;
  133.   len: LONGINT;
  134. BEGIN
  135.   nlen := str.Length(name) + 5;
  136.   ptr := e.AllocMem(nlen,LONGSET{e.public});
  137.   res := NIL;
  138.   IF ptr # NIL THEN
  139.     ptr^ := "ENV:";
  140.     str.Append(ptr^,name);
  141.     fh := d.Open(ptr^, d.oldFile);
  142.     IF fh # NIL THEN
  143.       len := d.Seek(fh, 0, d.end);
  144.       len := d.Seek(fh, 0, d.current);
  145.       IF len >= 0 THEN
  146.         ol.New(res,len+1);
  147.         IF res # NIL THEN
  148.           IF d.Seek(fh, 0, d.beginning) #0 THEN END;
  149.           IF d.Read(fh, res^, len) # len THEN
  150.             len := 0; END;
  151.           res[len] := 0X;
  152.         END;
  153.       END;
  154.       IF d.Close(fh) THEN END;
  155.     END;
  156.     e.FreeMem(ptr, nlen);
  157.   END;
  158.   RETURN res;
  159. END GetDEnv;
  160.  
  161.  
  162. PROCEDURE UnSetDEnv*(name: ARRAY OF CHAR): BOOLEAN;
  163. (* $CopyArrays- *)
  164. VAR
  165.   nlen: INTEGER;
  166.   ptr: StringPtr;
  167.   res: BOOLEAN;
  168. BEGIN
  169.   nlen := str.Length(name) + 5;
  170.   ptr := e.AllocMem(nlen,LONGSET{e.public});
  171.   IF ptr # NIL THEN
  172.     ptr^ := "ENV:";
  173.     str.Append(ptr^, name);
  174.     res := d.DeleteFile(ptr^);
  175.     e.FreeMem(ptr, nlen);
  176.   ELSE
  177.     res := FALSE;
  178.   END;
  179.   RETURN res;
  180. END UnSetDEnv;
  181.  
  182.  
  183. PROCEDURE SetDEnv*(name, string: ARRAY OF CHAR): BOOLEAN;
  184. (* $CopyArrays- *)
  185. VAR
  186.   nlen: INTEGER;
  187.   ptr: StringPtr;
  188.   res: BOOLEAN;
  189.   fh: d.FileHandlePtr;
  190.   slen: LONGINT;
  191. BEGIN
  192.   IF string = "" THEN
  193.     RETURN UnSetDEnv(name);
  194.   END;
  195.   nlen := str.Length(name) + 5;
  196.   slen := str.Length(string);
  197.   ptr := e.AllocMem(nlen,LONGSET{e.public});
  198.   res := FALSE;
  199.   IF ptr # NIL THEN
  200.     ptr^ := "ENV:";
  201.     str.Append(ptr^, name);
  202.     fh := d.Open(ptr^, d.newFile);
  203.     IF fh # NIL THEN
  204.       IF d.Write(fh, string, slen) = slen THEN
  205.         res := TRUE; END;
  206.       IF d.Close(fh) THEN END;
  207.     END;
  208.     e.FreeMem(ptr, nlen);
  209.   END;
  210.   RETURN res;
  211. END SetDEnv;
  212.  
  213. (*-------------------------------------------------------------------------*)
  214.  
  215. PROCEDURE GetFont*(name: ARRAY OF CHAR; size: INTEGER): g.TextFontPtr;
  216. (* $CopyArrays- *)
  217. VAR
  218.   font1,font2: g.TextFontPtr;
  219.   Ta: g.TextAttr;
  220. BEGIN
  221.   Ta.name  := sys.ADR(name);
  222.   Ta.ySize := size;
  223.   Ta.style := SHORTSET{};
  224.   Ta.flags := SHORTSET{};
  225.  
  226.   font1 := g.OpenFont(Ta);
  227.   IF (font1 = NIL) OR (font1.ySize # Ta.ySize) THEN
  228.     font2 := df.OpenDiskFont(Ta);
  229.     IF font2 # NIL  THEN
  230.       IF font1 # NIL THEN
  231.         g.CloseFont(font1); END;
  232.       font1 := font2;
  233.     END;
  234.   END;
  235.   RETURN font1;
  236. END GetFont;
  237.  
  238. (*-------------------------------------------------------------------------*)
  239.  
  240. (*
  241. (* keine Ahnung, was das macht. hG 12 Mar 1991 *)
  242. (* unterdrückt wahrscheinlich die Ausgabe in StdIO *)
  243.  
  244. PROCEDURE MountRequest*(bool: BOOLEAN): I.WindowPtr;
  245. VAR
  246.   proc: d.ProcessPtr;
  247.   originalPrWindowPtr: e.ADDRESS;
  248. BEGIN
  249.   proc := sys.VAL(d.ProcessPtr,e.FindTask(NIL));
  250.   IF NOT bool AND (proc.windowPtr # LONG(-1)) THEN
  251.     originalPrWindowPtr := proc.windowPtr;
  252.     proc.windowPtr := LONG(-1);
  253.     RETURN originalPrWindowPtr;
  254.   ELSIF bool AND (proc.windowPtr = LONG(-1)) THEN
  255.      proc.windowPtr := originalPrWindowPtr;
  256.      RETURN LONG(-1);
  257.   END;
  258. END MountRequest;
  259. *)
  260.  
  261. (*-------------------------------------------------------------------------*)
  262.  
  263. PROCEDURE StripIntuiMessages(mp: e.MsgPortPtr; win: I.WindowPtr);
  264. VAR
  265.   msg, succ: I.IntuiMessagePtr;
  266. BEGIN
  267.   msg := mp.msgList.head;
  268.   WHILE msg.execMessage.node.succ # NIL DO
  269.     succ := msg.execMessage.node.succ;
  270.     IF msg.idcmpWindow = win THEN
  271.       e.Remove(msg);
  272.       e.ReplyMsg(msg);
  273.     END;
  274.     msg := succ;
  275.   END;
  276. END StripIntuiMessages;
  277.  
  278.  
  279. (* this function closes an intuition window that *)
  280. (* shares a port with other intuition windows.   *)
  281.  
  282. PROCEDURE CloseWindowSafely*(VAR win: I.WindowPtr);
  283. BEGIN
  284.   I.ClearMenuStrip(win);
  285.   e.Forbid();
  286.   StripIntuiMessages(win.userPort,win);
  287.   win.userPort := NIL;
  288.   IF I.ModifyIDCMP(win,LONGSET{}) THEN END;
  289.   e.Permit();
  290.   I.CloseWindow(win);
  291.   win := NIL;
  292. END CloseWindowSafely;
  293.  
  294.  
  295. (* Opens a window and sets it's userPort to the specified Port *)
  296.  
  297. PROCEDURE OpenPortWindow*(nw: I.NewWindow; port: e.MsgPortPtr): I.WindowPtr;
  298. (* $CopyArrays- *)
  299. VAR
  300.   win: I.WindowPtr;
  301.   IDCMPs: LONGSET;
  302. BEGIN
  303.   IDCMPs := nw.idcmpFlags;
  304.   nw.idcmpFlags := LONGSET{};
  305.   win := I.OpenWindow(nw);
  306.   IF (win # NIL) AND (IDCMPs # LONGSET{}) THEN
  307.     win.userPort := port;
  308.     sys.SETREG(0,I.ModifyIDCMP(win,IDCMPs));
  309.   END;
  310.   RETURN win;
  311. END OpenPortWindow;
  312.  
  313. END SupLib.
  314.  
  315.